home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch1 / ScrWin.ctl < prev    next >
Text File  |  1999-04-16  |  7KB  |  243 lines
  1. VERSION 5.00
  2. Begin VB.UserControl ScrolledWindow 
  3.    ClientHeight    =   3600
  4.    ClientLeft      =   0
  5.    ClientTop       =   0
  6.    ClientWidth     =   4800
  7.    ControlContainer=   -1  'True
  8.    ScaleHeight     =   3600
  9.    ScaleWidth      =   4800
  10.    ToolboxBitmap   =   "ScrWin.ctx":0000
  11.    Begin VB.PictureBox Plug 
  12.       BorderStyle     =   0  'None
  13.       Height          =   1335
  14.       Left            =   2880
  15.       ScaleHeight     =   1335
  16.       ScaleWidth      =   1335
  17.       TabIndex        =   2
  18.       Top             =   1440
  19.       Width           =   1335
  20.    End
  21.    Begin VB.VScrollBar VBar 
  22.       Height          =   3375
  23.       Left            =   4560
  24.       TabIndex        =   1
  25.       Top             =   0
  26.       Width           =   255
  27.    End
  28.    Begin VB.HScrollBar HBar 
  29.       Height          =   255
  30.       Left            =   0
  31.       TabIndex        =   0
  32.       Top             =   3360
  33.       Width           =   4575
  34.    End
  35. End
  36. Attribute VB_Name = "ScrolledWindow"
  37. Attribute VB_GlobalNameSpace = False
  38. Attribute VB_Creatable = True
  39. Attribute VB_PredeclaredId = False
  40. Attribute VB_Exposed = True
  41. Attribute VB_Description = "CCC Scrolled window container control"
  42. Option Explicit
  43.  
  44. ' Current contained control offsets.
  45. Private xoff As Single
  46. Private yoff As Single
  47.  
  48. ' Border styles.
  49. Public Enum swBorderStyle
  50.     None_swBorderStyle = 0
  51.     Fixed_Single_swBorderStyle = 1
  52. End Enum
  53.  
  54. Private Const dflt_BorderStyle = Fixed_Single_swBorderStyle
  55. ' Move the contained controls appropriately.
  56. Private Sub HBar_Change()
  57.     ArrangeControls
  58. End Sub
  59. ' Move the contained controls appropriately.
  60. Private Sub VBar_Change()
  61.     ArrangeControls
  62. End Sub
  63. ' Move the contained controls appropriately.
  64. Private Sub HBar_Scroll()
  65.     ArrangeControls
  66. End Sub
  67. ' Move the contained controls appropriately.
  68. Private Sub VBar_Scroll()
  69.     ArrangeControls
  70. End Sub
  71. ' Arrange the scroll bars.
  72. Private Sub UserControl_Resize()
  73. Dim ctl As Object
  74. Dim is_visible As Boolean
  75. Dim xmax As Single
  76. Dim ymax As Single
  77. Dim x1 As Single
  78. Dim y1 As Single
  79. Dim got_wid As Single
  80. Dim got_hgt As Single
  81. Dim need_hbar As Boolean
  82. Dim need_vbar As Boolean
  83.  
  84.     ' Do nothing at design time.
  85.     If Not Ambient.UserMode Then
  86.         VBar.Visible = False
  87.         HBar.Visible = False
  88.         Plug.Visible = False
  89.         Exit Sub
  90.     End If
  91.  
  92.     ' Start with really wild values.
  93.     xmax = 0
  94.     ymax = 0
  95.     
  96.     ' In the following, if a control does not
  97.     ' have a given property, the value remains
  98.     ' unchanged. For example, in x1 = ctl.Left
  99.     ' if ctl has no Left property, the value of
  100.     ' x1 is whatever it was before the
  101.     ' operation.
  102.     '
  103.     ' The following are safe values for now.
  104.     ' Once a real value is set, the real value
  105.     ' will be safe for subsequent controls.
  106.     x1 = 0
  107.     y1 = 0
  108.  
  109.     ' Guard against controls with no Visible
  110.     ' Top, Left, Width, and Height properties.
  111.     On Error Resume Next
  112.  
  113.     ' Find bounds for the visible controls
  114.     ' contained within.
  115.     For Each ctl In ContainedControls
  116.         is_visible = False
  117.         is_visible = ctl.Visible
  118.         If is_visible Then
  119.             x1 = ctl.Left + ctl.Width
  120.             y1 = ctl.Top + ctl.Height
  121.             If xmax < x1 Then xmax = x1
  122.             If ymax < y1 Then ymax = y1
  123.         End If
  124.     Next ctl
  125.     
  126.     ' See which scroll bars we need.
  127.     got_wid = ScaleWidth
  128.     got_hgt = ScaleHeight
  129.     
  130.     ' See if we need the horizontal scroll bar.
  131.     If xmax > got_wid Then
  132.         ' We do. Leave room for it.
  133.         need_hbar = True
  134.         got_hgt = got_hgt - HBar.Height
  135.     Else
  136.         need_hbar = False
  137.     End If
  138.     ' See if we need the vertical scroll bar.
  139.     If ymax > got_hgt Then
  140.         ' We do. Leave room for it.
  141.         need_vbar = True
  142.         got_wid = got_wid - VBar.Width
  143.     
  144.         ' See if we now need the horizontal
  145.         ' scroll bar.
  146.         If (Not need_hbar) And (xmax > got_wid) Then
  147.             ' We do. Leave room for it.
  148.             need_hbar = True
  149.             got_hgt = got_hgt - HBar.Height
  150.         End If
  151.     Else
  152.         need_vbar = False
  153.     End If
  154.  
  155.     ' Arrange the controls.
  156.     If need_hbar Then
  157.         HBar.Move 0, got_hgt, got_wid
  158.         HBar.Max = xmax - got_wid
  159.         HBar.SmallChange = (xmax - got_wid) / 5
  160.         HBar.LargeChange = (HBar.Max - HBar.Min) * _
  161.             got_wid / (xmax - got_wid)
  162.         HBar.Visible = True
  163.     Else
  164.         HBar.Value = 0
  165.         HBar.Visible = False
  166.     End If
  167.     If need_vbar Then
  168.         VBar.Move got_wid, 0, VBar.Width, got_hgt
  169.         VBar.Max = ymax - got_hgt
  170.         VBar.SmallChange = (ymax - got_hgt) / 5
  171.         VBar.LargeChange = (VBar.Max - VBar.Min) * _
  172.             got_hgt / (ymax - got_hgt)
  173.         VBar.Visible = True
  174.     Else
  175.         VBar.Value = 0
  176.         VBar.Visible = False
  177.     End If
  178.     If need_hbar And need_vbar Then
  179.         Plug.Move got_wid, got_hgt, VBar.Width, HBar.Height
  180.         Plug.Visible = True
  181.     Else
  182.         Plug.Visible = False
  183.     End If
  184.  
  185.     ' Make sure these are on top.
  186.     HBar.ZOrder
  187.     VBar.ZOrder
  188.     Plug.ZOrder
  189.     
  190.     ' Place the contained controls.
  191.     ArrangeControls
  192. End Sub
  193. ' Position the contained controls.
  194. Private Sub ArrangeControls()
  195. Attribute ArrangeControls.VB_Description = "Arranges the controls for the current scroll bar values."
  196. Dim dx As Single
  197. Dim dy As Single
  198. Dim ctl As Object
  199. Dim is_visible As Boolean
  200.  
  201.     ' See where the controls should be.
  202.     dx = -HBar.Value - xoff
  203.     dy = -VBar.Value - yoff
  204.     xoff = dx + xoff
  205.     yoff = dy + yoff
  206.     
  207.     ' Guard against controls with no Visible,
  208.     ' Left, and Top properties.
  209.     On Error Resume Next
  210.  
  211.     ' Position the controls.
  212.     For Each ctl In ContainedControls
  213.         is_visible = False
  214.         is_visible = ctl.Visible
  215.         If is_visible Then
  216.             ctl.Move ctl.Left + dx, ctl.Top + dy
  217.         End If
  218.     Next ctl
  219. End Sub
  220. ' Set default property values.
  221. Private Sub UserControl_InitProperties()
  222.     BorderStyle = dflt_BorderStyle
  223. End Sub
  224. ' Read the property values.
  225. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  226.     BorderStyle = PropBag.ReadProperty("BorderStyle", dflt_BorderStyle)
  227. End Sub
  228.  
  229. ' Save the property values.
  230. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  231.     PropBag.WriteProperty "BorderStyle", BorderStyle, dflt_BorderStyle
  232. End Sub
  233.  
  234. ' Delegate BorderStyle to UserControl.
  235. Property Let BorderStyle(Style As swBorderStyle)
  236. Attribute BorderStyle.VB_Description = "Sets the control's border style."
  237.     UserControl.BorderStyle = Style
  238. End Property
  239. ' Delegate BorderStyle to UserControl.
  240. Property Get BorderStyle() As swBorderStyle
  241.     BorderStyle = UserControl.BorderStyle
  242. End Property
  243.